perm filename FILLNX.F4[XX,LCS] blob sn#231803 filedate 1976-08-15 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE FILLER(QQ,MD)
C00005 ENDMK
CāŠ—;
	SUBROUTINE FILLER(QQ,MD)
	COMMON /FLM/I(600) /ALF/NO,H(72) /PLTR/P,RHT,DIS
	DIMENSION Q(1)
C  H(72) =NO MORE THAN 72 SEGS AT ANY SLICE POSITION!!!
	EQUIVALENCE (Q,I)
	KNT=I(3)
	RL=Q(1)
	RR=RL
	DO 1 K=1,KNT,3
CC	Q(K)=IFIX(Q(K))
CC	Q(K+1)=IFIX(Q(K+1))
	IF(I(K+2).EQ.3)I(K+2)=-1

	A=Q(K)
	IF(Q(K+3).EQ.A)I(K+5)=-1
C VERTICAL LINES WILL BE IGNORED.
	IF(RL.GT.A)RL=A
1	IF(RR.LT.A)RR=A
C GET LEFT AND RIGHT EXTREME LIMITS.
	
	RR=RR-.5
	RL=RL-.5
2	RL=RL+1
C SLICE COUNTER
	IF(RL.GT.RR)RETURN
	M=0
	DO 3 J=4,KNT,3
	IF(I(J+2))GO TO 3
	IF(IHORZ(I,J,RL))GO TO 3
C FINDS SEGS UNDER SLICE AND REJECTS VERTICALS.
	M=M+1
	H(M)=HGT(J,RL,I)
3	CONTINUE
	IF(M.EQ.0)GO TO 2
C  M=0=SPACE BETWEEN OBJECTS -- NO FILLER
	J=1
5	IF(H(J).GE.H(J+1))GO TO 4
C  SORTS HEIGHTS
	CALL EXCH(H(J),H(J+1))
	IF(J.EQ.1)GO TO 4
	J=J-1
	GO TO 5
4	J=J+1
	IF(J.LT.M)GO TO 5
C GO BACK IF MORE SORTING TO BE DONE
	NN=1
6	IF(H(NN).EQ.H(NN+1))GO TO 7
	A=H(NN)
	B=H(NN+1)
	IF(A-B.GT.1)CALL LINX(RL,A-1.,RL,B+1.)
7	NN=NN+2
C SKIP BY 2'S
	IF(NN.LT.M)GO TO 6
	GO TO 2
	END
	
	FUNCTION HGT(J,RL,Q)
	DIMENSION Q(1)
	HGT=Q(J-2)
C  PREVIOUS Y COORD.
	A=Q(J-3)
C  PREVIOUS X COORD.
	HGT=((Q(J+1)-HGT)*(RL-A))/(Q(J)-A)+HGT
CAN HAVE A DIVIDE BY ZERO HERE!!
	END
	
	FUNCTION IHORZ(Q,J,RL)
C  L=VERT. SLICE
	DIMENSION Q(1)
	IHORZ=-1
	A=Q(J)
	B=Q(J-3)
C PREVIOUS X COORD.
	IF(A.GT.B)CALL EXCH(A,B)
	IF(RL.LE.B.AND.RL.GE.A)IHORZ=0
	END